home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0017_Simple coppering routine.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  4KB  |  193 lines
  1. {
  2. SEAN PALMER
  3.  
  4. >Okay, I've got this small problem porting one of my assembler routines
  5. >into pascal.  It's a simple coppering routine (multiple setting of the
  6. >same palette register for trippy effects :), and i can't seem to use it
  7. >in my code..  I'll post the code here now (it's fairly short), and if
  8. >someone could help me out here, i'd be most grateful - since my
  9. >assembler/pascal stuff isn't too great..
  10.  
  11. I imported it, but couldn't get it to work (several problems in the
  12. source) and in the process of getting it to work (for one thing I didn't
  13. know what it was supposed to accomplish in the first place) I added a
  14. few things to it and this probably isn't what you wanted it to look like
  15. but it wouldn't be hard to do now that it's in TP-acceptable form.
  16.  
  17. I also added one other small palette flipper that's kind of neat.
  18. }
  19.  
  20. {$G+}
  21. uses
  22.   crt;
  23.  
  24. procedure copperBars(var colors; lines : word; regNum, count : byte); assembler;
  25. var
  26.   c2 : byte;
  27. asm
  28. {
  29.   okay, Colors is a pointer to the variable array of
  30.   colours to use (6bit rgb values to pump to the dac)
  31.   Lines is the number of scanlines on the screen (for syncing)
  32.   RegNum is the colour register (DAC) to use.
  33.   valid values are 0-255. that should explain that one.
  34.   Count is the number of cycles updates to do before it exits.
  35. }
  36.   push ds
  37.  
  38.   mov  ah, [RegNum]
  39.   mov  dx, $3DA   {vga status port}
  40.   mov  bl, $C8    {reg for DAC}
  41.   cli
  42.   cld
  43.  
  44.  @V1:
  45.   in   al, dx
  46.   test al, 8
  47.   jz   @V1 {vertical retrace}
  48.  @V2:
  49.   in   al, dx
  50.   test al, 8
  51.   jnz  @V2
  52.  
  53.   mov  c2, 1
  54.   mov  di, [lines]
  55.  
  56.  @UPDATER:
  57.   mov  bh, c2
  58.   inc  c2
  59.   lds  si, [colors]
  60.                 {now,just do it.}
  61.  @NIKE:
  62.   mov  cx, 3
  63.   mov  dl, $DA
  64.  
  65.  @H1:
  66.   in   al, dx
  67.   and  al, 1
  68.   jz   @H1  {horizontal retrace}
  69.  
  70.   mov  al, ah  {color}
  71.   mov  dl, bl
  72.   out  dx, al
  73.   inc  dx
  74.   rep  outsb              {186 instruction...}
  75.  
  76.   mov  dl, $DA
  77.  @H2:
  78.   in   al, dx
  79.   and  al, 1
  80.   jnz  @H2;
  81.  
  82.   dec  di
  83.   jz   @X
  84.   dec  bh
  85.   jnz  @NIKE
  86.   jmp  @UPDATER
  87.  @X:
  88.   dec  count
  89.   jnz  @V1
  90.   sti                    {enable interrupts}
  91. End;
  92.  
  93. procedure freakout0(lines : word; count : byte); assembler;
  94. asm
  95.   mov dx, $3DA   {vga status port}
  96.   cli
  97.   cld
  98.  
  99.  @V1:
  100.   (* in   al, dx
  101.      test al, 8
  102.      jz   @V1 {vertical retrace}
  103.   @V2:
  104.      in   al, dx
  105.      test al, 8
  106.      jnz  @V2
  107.   *)
  108.  
  109.   mov di,[lines]
  110.  
  111.  @L:
  112.   mov  dl, $C8
  113.   mov  al, 0  {color}
  114.   out  dx, al
  115.   inc  dx
  116.   mov  al, bh
  117.   out  dx, al
  118.   add  al, 20
  119.   out  dx, al
  120.   out  dx, al
  121.   add  bh, 17
  122.   mov  dl, $DA
  123.   in   al, dx
  124.   test al, 1
  125.   jz   @L;  {until horizontal retrace}
  126.  
  127.   dec  di
  128.   jnz  @L
  129.  
  130.   mov  dl, $DA
  131.   dec  count
  132.   jnz  @V1
  133.   sti                    {enable interrupts}
  134. End;
  135.  
  136. const
  137.  pal : array [0..3 * 28 - 1] of byte =
  138.    (2,4,4,
  139.     4,8,8,
  140.     6,12,12,
  141.     8,16,16,
  142.     10,20,20,
  143.     12,24,24,
  144.     14,28,28,
  145.     16,32,32,
  146.     18,36,36,
  147.     20,40,40,
  148.     22,44,44,
  149.     24,48,48,
  150.     26,52,52,
  151.     26,52,52,
  152.     28,56,56,
  153.     28,56,56,
  154.     30,60,60,
  155.     30,60,60,
  156.     30,60,60,
  157.     33,63,63,
  158.     33,63,63,
  159.     33,63,63,
  160.     33,63,63,
  161.     33,63,63,
  162.     30,60,60,
  163.     28,56,56,
  164.     26,52,52,
  165.     24,48,48);
  166.  
  167. var
  168.   i : integer;
  169.  
  170. begin
  171.   asm
  172.     mov ax, $13
  173.     int $10
  174.   end;
  175.   for i := 50 to 149 do
  176.     fillchar(mem[$A000 : i * 320 + 50], 220, 1);
  177.  
  178.   repeat
  179.     copperBars(pal, 398, 0, 8);  {398 because of scan doubling}
  180.   until keypressed;
  181.   readkey;
  182.  
  183.   repeat
  184.     freakout0(398, 8);  {398 because of scan doubling}
  185.   until keypressed;
  186.   readkey;
  187.  
  188.   asm
  189.     mov ax, 3
  190.     int $10
  191.   end;
  192. end.
  193.